home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / copyRing.tcl < prev    next >
Encoding:
Text File  |  1998-11-14  |  3.2 KB  |  148 lines  |  [TEXT/ALFA]
  1. # (install)
  2. # Implementation of Emacs's kill ring. This is a paste ring.
  3.  
  4. alpha::feature copyRing 0.1.2 global {
  5. } {
  6.     menu::replaceWith Edit "/X<Scut" items "/X<Scut" "/X<S<I<Ocut&Append"
  7.     menu::replaceWith Edit "/C<Scopy" items "/C<Scopy" "/C<S<I<Ocopy&Append"
  8.     menu::replaceWith Edit "/V<Spaste" items "/V<Spaste" "/V<S<I<OpastePop"
  9.     if {[info commands copyringCopy] == ""} {
  10.     set renamedRing 1
  11.     rename copy copyringCopy
  12.     rename cut copyringCut
  13.     rename paste copyringPaste
  14.     }
  15.     # to force loading of procs below
  16.     catch {copy&Append blah blah}
  17. } {
  18.     set renamedRing 0
  19.     rename copy ""
  20.     rename paste ""
  21.     rename cut ""
  22.     rename copyringCopy copy
  23.     rename copyringCut cut
  24.     rename copyringPaste paste
  25. } help {
  26.     Provides an implementation of a copy/paste ring.
  27. }
  28.  
  29. set ringDepth     5
  30. set ringIn         0
  31. set ringOut         0
  32. set pasteStart     0
  33. set pasteFinish    0
  34.  
  35. proc copy&Append {} {
  36.     set old [getScrap]
  37.     putScrap "$old[getSelect]"
  38.     message "Appended"
  39. }
  40.  
  41.  
  42. proc cut&Append {} {
  43.     set old [getScrap]
  44.     putScrap "$old[getSelect]"
  45.     deleteText [getPos] [selEnd]
  46.     message "Appended"
  47. }
  48.  
  49.  
  50.  
  51. proc copy {} {
  52.     global copyring ringDepth ringIn
  53.     
  54.     set len [expr [selEnd] - [getPos]]
  55.     if {!$len} {
  56.         if {[getMark] < [getPos]} {
  57.             set text [getText [getMark] [getPos]]
  58.             set len [expr [getPos] - [getMark]]
  59.         } else {
  60.             set text [getText [getPos] [getMark]]
  61.             set len [expr [getMark] - [getPos]]
  62.         }
  63.         if {![string length $text]} return
  64.     } else {
  65.         set text [getSelect]
  66.     }
  67.  
  68.  
  69.     set copyring([expr {$ringIn % $ringDepth}]) $text
  70.     incr ringIn
  71.     
  72.     copyringCopy
  73. }
  74.  
  75.  
  76. proc cut {{rect 0}} {
  77.     global copyring ringDepth ringIn intelCutPaste
  78.     
  79.     set len [expr [selEnd] - [getPos]]
  80.     if {!$len} {
  81.         if {[getMark] < [getPos]} {
  82.             set text [getText [getMark] [getPos]]
  83.             set len [expr [getPos] - [getMark]]
  84.         } else {
  85.             set text [getText [getPos] [getMark]]
  86.             set len [expr [getMark] - [getPos]]
  87.         }
  88.         if {![string length $text]} return
  89.     } else {
  90.         set text [getSelect]
  91.     }
  92.  
  93.     set copyring([expr {$ringIn % $ringDepth}]) $text
  94.     incr ringIn
  95.  
  96.     copyringCut
  97.  
  98.     if {$intelCutPaste && !$rect} {
  99.         if {[isWhite 0] && [isWhite -1]} {
  100.             backSpace
  101.         }
  102.     }
  103. }
  104.  
  105. proc paste {{rect 0}} {
  106.     global copyring ringDepth ringIn ringOut intelCutPaste pasteStart pasteFinish
  107.     set intel 0
  108.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  109.     if {!$rect && $intelCutPaste} {
  110.         set left -1
  111.         set right [expr [selEnd] - [getPos]]
  112.         if {[isWhite $right] && [isChar $left]} {
  113.             clear
  114.             insertText " "
  115.         } elseif {[isWhite $left] && [isChar $right]} {set intel 1}
  116.     }
  117.     copyringPaste
  118.     set pasteStart [getMark]
  119.     set pasteFinish [getPos]
  120.     if {$intel && ([lookAt [expr [getPos]-1]] != "\r")} {
  121.         insertText " "
  122.     }
  123. }
  124.  
  125.  
  126. proc isWhite {off} {
  127.     set c [lookAt [expr [getPos] + $off]]
  128.     return [expr {($c == " ")}]
  129. }
  130.  
  131. proc isChar {off} {
  132.     set c [lookAt [expr [getPos] + $off]]
  133.     return [expr {[string match {[a-z]} $c]}]
  134. }
  135.  
  136.     
  137. proc pastePop {} {
  138.     global copyring ringDepth ringIn ringOut pasteFinish pasteStart
  139.     
  140.     if {!$ringIn} { beep; return}
  141.     
  142.     set ringOut [expr $ringOut-1]
  143.     if {$ringOut < 0} {set ringOut [expr (($ringDepth > $ringIn) ? $ringIn : $ringDepth) - 1]}
  144.     
  145.     replaceText $pasteStart $pasteFinish $copyring($ringOut)
  146.     set pasteFinish [expr $pasteStart + [string length $copyring($ringOut)]]
  147. }
  148.